00100	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200	C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
00300	C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400	
00500	
00600	C   6/10/72 **********  SCORE  **********  LELAND SMITH, SEP.1969
00700	
00800	C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
00900	C   GENERATION PROGRAM.
01000	C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100	C   LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200	C   SCANX, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300	C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400	C	SUBROUTINE SUBR
01500	C	COMMON /INS/ INST(27),BG(60)
01600	C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
01700	C   INUM=INST#  IPAR=PARAM#  
01800	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
02000	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
02100	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
02200	C   F1=86  F15=100 (NO F16!)
02300	
02400		COMMON /Q/ BNW(100),NWZ
02500		COMMON /INS/INST,BG
02600		DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
02700		1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
02800		1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4)
02900		1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
03000		1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
03100	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
03200	C   40 LIT CHARS + 30 PARAMS PER INST.
03300	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
03400		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600		1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03700		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
03800		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
03900		1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
04000		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
04200		1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
04300		1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
04400		1 ,(IFM4,IFM(4)),(IFM(3),LIST)
04500		DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
04600		1, JFM(3)/','/
04700	C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
04800		DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900		1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000		1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05100		1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
05200		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
05300		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
05400		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
05500		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
05600		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
05700		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
05800		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
05900		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
06000		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
06100		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
06200		1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
06300		LPAR=0
06400		IPRN=0
06500		QX=0.
06600		MOT=0
06700		RETRO=-1.
06800		INVRT=-1
06900		LCNT=1
07000		PARENS=0
07100	      JZ=1  
07200		CALL RNDINT
07300	      PR=0  
07400		IAMP=0
07500	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07600	      T5=0  
07700	      NINS=0
07800		K=0
07900		IDALL=-1
08000		QTS=-1.
08100	      KB=0  
08200	      NWZ=1
08300		BNW(1)=0
08400		I=1
08500	      KL=0  
08600	      TP=0  
08700		KN=IBLA
08800	      RA=0  
08900	      CHN=0 
09000		DO 127 K=1,77,3
09100	127	LIST(K)=0
09200	C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09300		NWX=0
09400		BY=-1
09500	      DO 1128 K=1,KZY     
09600		INVIS(K)=0
09700		INST(K)=0
09800		CNT(K)=0
09900		RDEV(K)=0
10000	C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10100		NP(K)=0
10200		IQ(K)=0
10300	C   IQ IS FOR RESTART FLAG
10400		IPT(K,1)=0
10500	      DO 1128 L=1,32    
10600	1128   PCH(K,L)=0 
10700	
10800		ITYP=-1
10900	C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11000	C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
11100		JED=-1
11200	2112	TYPE 8002
11300	1112	ACCEPT 77732,INP
11400		JFM(4)='5F)'
11500		JFM(1)='   (A'
11600	C   FOR FREE 'A' FORMAT
11700		CALL FMT(JFM,INP,MLX)
11800		REREAD JFM,K,TF,AMPFAC,OP1,DURX
11900	C  JFM IS THE CURRENT FORMAT STATEMENT
12000		IF(K.NE.'EDIT')GO TO 3112
12100		JED=0
12200		GO TO 2112
12300	C  'E(DIT)' GOES TO EDIT MODE
12400	3112	IF(TF.EQ.0)TF=1.
12500		IF(AMPFAC.EQ.0)AMPFAC=1.
12600	CC**FROM 11700 CHANGED 3/73  IF(TF.NE.999.)GO TO 21122
12700	21122	IF(K.NE.'TYPE')GO TO 128
12800		ITYP=0
12900		DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
13000		TYPE FINM
13100	C  TO USE TYPE-IN MODE.  FILE OF INPUT IS WRITTEN ON FOR21.DAT
13200		ACCEPT 1127,ISLAC
13300		IF(ISLAC.EQ.IBLA)STOP
13400		REWIND 21
13500	CC	WRITE (21,11122) ISLAC
13600		WRITE (21,1127) ISLAC
13700		GO TO 3127
13800	11122	FORMAT(1XA5,72A1)
13900	128	IF(K.NE.'INFO')GO TO 3128
14000		TYPE 8002
14100		TYPE 1113
14200		TYPE 118
14300		TYPE 1114
14400		TYPE 8002
14500		GO TO 1112
14600	118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14700	8002	FORMAT(' TYPE FILE NAME'/)
14800	8001	FORMAT(A5,5F)
14900	107	FORMAT(I,A5,5F)
15000	1113	FORMAT('     NAME, TF, AMPFAC, OMIT", DUR".'/)
15100	1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15200		1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15300		1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15400	1127	FORMAT(A5,72A1)
15500	3128	IF(K.NE.IBLA)IFLNM=K
15600		CALL IFILE(1,IFLNM)
15700		READ(1,107)LN,ISLAC
15800		REREAD 77732,INP
15900	C   FOR LATER USE
16000		IF(LN.NE.0)GO TO 3127
16100	C   JUMP IF THE FILE HAS LINE NUMBERS.
16200		REREAD 1127,ISLAC
16300	C   REREADS FIRST LINE
16400	CC	IF(ISLAC.NE.'COMME')GO TO 3127
16500	CC	DO 31271 K=1,72
16600	CC	READ(1,77732),KL,KL
16700	CC31271	IF(KL.EQ.ISEMI)GO TO 3127
16800	C  TO SKIP OVER 'COMMENT' SECTION  OF TVED FILES.
16900	
17000	3127	TYPE 118
17100		IF(DURX.EQ.0)DURX=19999.
17200		IXIN=1
17300	CC -- NOW AT TOP OF PAGE 4(2/74)	DO 1107 K=1,30
17400	CC1107	PL(K)=1.
17500		INONLY=-1
17600		ACCEPT 300,MX,X,Y,Z
17700		IF(Z.NE.0)INONLY=Z
17800		IF(X.NE.0)IXIN=X
17900	C   MX=3 GIVES DURS ONLY
18000	C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
18100	C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
18200		MZ=0
18300		JOUT=5
18400	C  5=OUTPUT TO TTY
18500		SOS=-1.
18600		IF(Y.NE.0)SOS=0  
18700	C  IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18800		IF(MX.NE.22)GO TO 2107
18900		JOUT=22
19000		REWIND 22
19100	2107	IF(MX.LE.1)MX=MX-2
19200		IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19300		IF(MX.EQ.4)MZ=-4
19400		IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19500	CC	IF(ITYP.EQ.0)GO TO 2308
19600	CC	WRITE(JOUT,77732)INP
19700	
19800	C   *************** READS INPUT  ***********************
19900	2308	IF(ITYP)GO TO 2127
20000		DATA TINST /25H(' TYPE INST NAME, ETC'/)/
20100		1,TEDIT/20H(' RETYPE LINE?'/  )/
20200	23081	TYPE TINST
20300		ACCEPT 77732,INP
20400		IF(JED)WRITE(21,77732)INP
20500		JFM(4)='72A1)'
20600	C  PUTS ON LPT AND TTY
20700	CC	JFM(1)='   (A'
20800	CC	CALL FMT(JFM,INP,MLX)
20900	CC	REREAD JFM,J,INP
21000	CC	WRITE(21,11122) J,INP
21100		GO TO 1074
21200	2127	JREAD=1
21300	4400	READ(1,77732,END=2337)INP
21400		IF(SOS)WRITE(JOUT,87732)INP
21500		GO TO(441,442,443,444,445,446)JREAD
21600	
21700	441	JFM(4)='72A1)'
21800		IF(LN.EQ.0)GO TO 1074
21900		REREAD 2114,LN,INP
22000		JFM(1)=' (I,A'
22100		CALL FMT(JFM,INP,MLX)
22200		REREAD JFM,LN,J,INP
22300		GO TO 4127
22400	1074	JFM(1)='   (A'
22500		CALL FMT(JFM,INP,MLX)
22600		REREAD JFM,J,INP
22700	CC	IF(LN.EQ.0)READ(1,1127,END=2337)J,INP
22800	4127	IF(JED.OR.K.EQ.'Y')GO TO 41271
22900	C  K CHECK IS TO PASS AFTER RETYPING
23000		TYPE TEDIT
23100		ACCEPT 77732,K
23200		IF(K.EQ.'Y')GO TO 23081
23300		IF(K.EQ.'G')JED=-1
23400	
23500	
23600	41271	IF(J.EQ.IBLA)GO TO 2308
23700		MLX=1
23800		IZ=0
23900		JA=-1
24000		ISUB=4
24100		ALL=1.
24200		VX1=0
24300		VX2=0
24400		VX3=0
24500		LK=-1
24600		K=0
24700		IF(V(I-1).NE.-9900.-BY)GO TO 364
24800		BY=-1.
24900		I=I-1
25000	364	DO 361 JD=1,72
25100		N=INP(JD)
25200		IF(N.NE.'R')GO TO 361
25300	C  LOOKS FOR 'RESTART'
25400		DO 3611 M=JD,72
25500		KL=INP(M)
25600		IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25700	CC	IF(INP(M).EQ.IBLA)GO TO 3631
25800	3611	INP(M)=IBLA
25900	C   CHANGES 'RESTART' TO BLANKS
26000	3631	DO 363 N=1,NINS
26100		IF(J.NE.INST(N))GO TO 363
26200		IQ(N)=-1
26300	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
26400		GO TO 362
26500	363	CONTINUE
26600	361	IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
26700	6773	K=K+1
26800		IF(K.GT.NINS)GO TO 36
26900		IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
27000	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
27100		LK=K
27200		GO TO 1773
27300	36	IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
27400		IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6  
27500		IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27600		1GO TO 1773
27700		IF(J.EQ.'SECTI')GO TO 1081
27800	C******************  ABOVE AND BELOW FOR 'SECTIONS'
27900		IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
28000	362	LK=NINS+1
28100		IF(LK.GT.KZY)GO TO 99
28200		INST(LK)=J
28300		IZ=LK
28400		GO TO 1773
28500	
28600	C*********** DOWN TO 99 FOR 'SECTIONS'
28700	1083	V(I)=-99.
28800		KL=1
28900		GO TO 3083
29000	C  READS 'PLAY SECT. N1,N2'
29100	1081	V(I)=-199.
29200		KL=4
29300	3083	DO 2081 K=KL,72
29400		IF(INP(K).EQ.IBLA)GO TO 2081
29500		IV(I+1)=INP(K)
29600		I=I+2
29700	3081	BY=-1.
29800		GO TO 2308
29900	2081	CONTINUE
30000	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
30100	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
30200	C********* FEB 15,71
30300	1082	V(I)=-299.
30400		I=I+1
30500		GO TO 3081
30600	C   MARKS END OF SECTION
30700	C************************
30800	
30900	99	TYPE 199,LN
31000		STOP
31100	199	FORMAT(' ERROR!!  LAST LINE READ =',I6/)
31200	4	IF(LK.LE.NINS)GO TO 8773
31300		IF(ALL.GT.0)GO TO 1004
31400		IF(IDALL.GT.0)GO TO 8773
31500		BG(LK)=VX1
31600		IDALL=LK
31700		GO TO 2004
31800	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31900	1004	BG(LK)=VX1
32000		IF(LK.EQ.IZ)VX1=0
32100	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
32200	C   CHECK EFFECT ON 'MOVE'!
32300	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
32400	2004	NINS=LK
32500		IF(VX3.NE.0)VX2=10000.+VX3
32600		IF(VX2.EQ.0)VX2=-1
32700		DUR(LK)=VX2
32800		GO TO 900
32900	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
33000	8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
33100	900	IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
33200	C*********** 'PLAY' IS FOR 'SECTIONS'
33300		BY=VX1
33400	C  BY=CURRENT BG TIME.
33500	C********* FEB 15,71
33600		V(I)=-9900.-BY
33700		I=I+1
33800		IF(NWZ.NE.0)CALL BGSORT(BY)
33900	5773	IF(J.EQ.'TEMPO')GO TO 1106
34000		IF(J.EQ.'CONDU')GO TO 3018
34100		IF(J.EQ.'PLAY')GO TO 1083
34200	C*********** ABOVE FOR 'SECTIONS'
34300	4773	NW=LPAR
34400		IF(I.GT.1900.)TYPE 107,I
34500		ALL=1.
34600		DF=0
34700		ISUB=1
34800	1299	IF(JZ.NE.0)GO TO 1773
34900	
35000	
35100	7773	IF(ITYP)GO TO 77731
35200		DATA TPALN /20H(' TYPE A LINE'/)   /
35300	77734	TYPE TPALN
35400		ACCEPT 77732,INP
35500		IF(JED)WRITE(21,77732) INP
35600		IF(INP1.EQ.IBLA)GO TO 77734
35700		GO TO 77733
35800	77732	FORMAT(72A1)
35900	87732	FORMAT(1X72A1)
36000	77731	JREAD=2
36100		GO TO 4400
36200	442	IF(LN.NE.0)REREAD 2114,LN,INP
36300		IF(INP1.EQ.IBLA)GO TO 77731
36400		IF(JED)GO TO 77733
36500		TYPE TEDIT
36600		ACCEPT 77732,K
36700		IF(K.EQ.'Y')GO TO 77734
36800		IF(K.EQ.'G')JED=-1
36900	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
37000	CC	IF(SOS)WRITE(JOUT,2114),LN,INP
37100	
37200	
37300	77733	MLX=1
37400	C   'LISTS' MUST END WITH * 
37500	CC1773	JZ=0
37600	1773	IF(IPRN.EQ.0)GO TO 17732
37700		L=I-1
37800		IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37900		IPRN=IPRN-1
38000		IF(PARENS.EQ.0)GO TO 17733
38100		PARENS=0
38200		LIST(LCNT+2)=L
38300		LCNT=LCNT+3
38400		IF(IPRN.EQ.0)GO TO 17732
38500		IPRN=0
38600	17733	LIST(MOT)=L
38700		MOT=0
38800	C   FOR ERROR TRAP
38900	
39000	17732	JZ=0
39100		N=0
39200	17731	ML=MLX
39300	
39400	C   BIG LOOP -- TO END OF PAGE 1.
39500		JD=ML
39600	975	N=INP(JD)
39700		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39800	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
39900	33611	IF(N.NE.'('.AND.N.NE.')')GO TO 2361
40000		INP(JD)=IBLA
40100		L=JD-1
40200	5113	IF(INP(L).NE.IBLA)GO TO 2113
40300		L=L-1
40400		GO TO 5113
40500	2113	IF(N.EQ.')')GO TO 3361
40600		IF(PARENS.EQ.0)GO TO 1140
40700		LCNT=LCNT+3
40800		IF(MOT.NE.0)GO TO 11403
40900		MOT=LCNT-1
41000	1140	DO 11401 JC=1,LCNT-1,3
41100		IF(INP(L).NE.LIST(JC))GO TO 11401
41200	C  FINDS DUPLICATE IDENTIFIER
41300		TYPE 11402,INP(L)
41400		GO TO 99
41500	11403	TYPE 11404
41600		GO TO 99
41700	11404	FORMAT(' MORE THAN 2 PARENS OPEN'/)
41800	
41900	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
42000	11401	CONTINUE
42100		LIST(LCNT)=INP(L)
42200		PARENS=-1.
42300		INP(L)=IBLA
42400		LIST(LCNT+1)=I
42500		GO TO 236
42600	CC33612	IF(QTS)GO TO 236
42700	CC	GO TO 6721
42800	C ''''''' FOR SINGLE QUOTES
42900	3361	IPRN=IPRN+1
43000	CC	IF(QTS)GO TO 236
43100	CC	GO TO 7231
43200		GO TO 236
43300	C  JUMPS BACK INTO QUOTE SECTION
43400	CQ	IF(PARENS.EQ.0)GO TO 2140
43500	CQ	LIST(LCNT+2)=L
43600	CQ	LCNT=LCNT+3
43700	CQ	PARENS=0
43800	CQ	GO TO 33612
43900	CQ2140	LIST(MOT)=L
44000	CQ	GO TO 33612
44100	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
44200	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
44300	2361	IF(N.NE.'@')GO TO 5361
44400		DO 113 L=1,72
44500		K=JD+L
44600	C   K IS USED AT 240!!!
44700		JG=INP(K)
44800		IF(JG.NE.'-')GO TO 6113
44900		RETRO=0
45000		INP(K)=IBLA
45100		GO TO 113
45200	6113	IF(JG.NE.'$')GO TO 7113
45300	C  '$' IS FOR INVERSIONS IN 'NOTES'
45400		INVRT=0
45500		GO TO 113
45600	7113	IF(JG.NE.IBLA)GO TO 4113
45700	113	CONTINUE
45800	4113	DO 6361 L=1,LCNT,3
45900		IF(JG.NE.LIST(L))GO TO 6361
46000		VX1=0
46100		DO 40 M=JD+2,72
46200		JG=INP(M)
46300		IF(JG.EQ.IBLA)GO TO 40
46400		IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
46500		ML=M
46600		GO TO 240
46700	40	CONTINUE
46800	240	JC=JA
46900		JA=-1
47000		INP(K)=IBLA
47100		CALL SCANR
47200		JA=JC
47300	140	JC=1
47400		KN=LIST(L+1)
47500		M=LIST(L+2)+1
47600		IF(RETRO)GO TO 640
47700		JC=M-1
47800		M=KN-1
47900		KN=JC
48000		JC=-1
48100		RETRO=-1.
48200	640	IF(INVRT)GO TO 940
48300	840	X=V(KN)
48400		V(I)=X+VX1
48500	C  FINDS CENTER FOR INVERSION (+TRANSP.)
48600		I=I+1
48700		KN=KN+JC
48800		IF(V(KN-JC).NE.85.)GO TO 940
48900		V(I-1)=85.
49000		GO TO 840
49100	
49200	940	Z=V(KN)
49300		IF(INVRT.EQ.0)GO TO 440
49400		IF(VX1.EQ.0)GO TO 540
49500	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
49600		IF(CODE.EQ.-33.)GO TO 440
49700		V(I)=Z*VX1
49800		GO TO 7361
49900	440	IF(Z.EQ.85.)GO TO 540
50000		Y=0
50100		IF(INVRT.EQ.0)Y=(X-Z)*2.
50200		V(I)=Z+VX1+Y
50300		GO TO 7361
50400	540	V(I)=Z
50500	7361	I=I+1
50600		KN=KN+JC
50700		IF(KN.NE.M)GO TO 940
50800	
50900		INVRT=-1
51000		RB=V(I-1)
51100	CC	ICT=-1
51200		DO 8361 L=JD,72
51300		JG=INP(L)
51400	CC	IF(JG.EQ.ISEMI)GO TO 93611
51500	C   PUT IN NOV 25, 72
51600		IF(JG.EQ.ISEMI)GO TO 93612
51700		INP(L)=IBLA
51800		IF(JG.EQ.KSLA)GO TO 9361
51900		IF(JG.EQ.')')IPRN=IPRN+1
52000	CC8361	IF(JG.EQ.'*')ICT=0
52100	8361	IF(JG.EQ.'*')IAMP=-1
52200	9361	MLX=L
52300	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
52400	CC	IF(ICT.AND.QTS)GO TO 17731
52500	CC↓↓↓↓↓↓↓↓↓↓↓ CHNGD JUNE 24,73	IF(IAMP.EQ.0.AND.QTS)GO TO 17731
52600		IF(IAMP.EQ.0.AND.QTS)GO TO 1773
52700		JZ=-1
52800	CC			IF(QTS)GO TO 3013
52900	93612	IF(IAMP.EQ.0)GO TO 93611
53000	CC93612			IF(ICT.EQ.0)IAMP=-1
53100	C   NOV 25, 72
53200		IF(QTS)GO TO 3013
53300		GO TO 2722
53400	CC93611			IF(ICT.EQ.0.AND.QTS.EQ.0)GO TO 2722
53500	CC93611			IF(IAMP.AND.QTS.EQ.0)GO TO 2722
53600	C  THESE ARE FOR "LIT" ITEMS
53700	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT' ******  ! ! ! !
53800	CC			IF(QTS)GO TO 7773
53900	93611	IF(JG.EQ.ISEMI)GO TO 7773
54000		JZ=0
54100		IF(IPRN.NE.0)GO TO 1773
54200	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
54300		GO TO 236
54400	C  LAST TIME FOR QUOTES
54500	
54600	CC93611	IF(ICT.AND.QTS)GO TO 7773
54700	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
54800	CC	IF(QTS)GO TO 3013
54900	CC	IF(ICT)GO TO 6721
55000	C   JUMPS TO END STRING OF QUOTES
55100	6361	CONTINUE
55200		GO TO 99
55300	C @@@@@@@@@@@@@@@@@@@@@@@@@@
55400	5361	IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
55500		IF(INP(JD+1).NE.IF)GO TO 236
55600	C  JUMP IF NOT DUTY FACTOR
55700		DF=DF-100.
55800	CC	GO TO 53611
55900		GO TO 43615
56000	53611	IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
56100		DF=DF-200
56200	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
56300		GO TO 43615
56400	53612	IF(N.NE.IAA)GO TO 43611
56500	C   FINDS 'ALL'.
56600		IF(INP(JD+1).NE.'L')GO TO 236
56700		ALL=-1.
56800	CC	INP(JD+2)=IBLA
56900	CC53611	INP(JD)=IBLA
57000	CC	INP(JD+1)=IBLA
57100	CC	GO TO 236
57200		GO TO 43615
57300	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
57400	
57500	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
57600	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
57700	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
57800	C   BEFORE! QUAD (IF USED).
57900	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
58000	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
58100	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
58200	43611	IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
58300		QX=-13.
58400		DO 43612 N=JD,72
58500		J=INP(N)
58600		IF(J.EQ.IXX)QX=QX-1.
58700		IF(J.EQ.IF)QX=QX-2.
58800		IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
58900	43612	INP(N)=IBLA
59000	4361	IF(N.NE.'I')GO TO 43613
59100		IF(ISUB.NE.4)GO TO 43613
59200	C  NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
59300		INVIS(LK)=-1
59400	43615	DO 43614 L=JD,72
59500		N=INP(L)
59600		IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
59700	43614	INP(L)=IBLA
59800	43613	IF(N.NE.KSLA)GO TO 636
59900		MLX=JD+1
60000		JZ=-1
60100		INP(JD)=ISEMI
60200	436	IF(INP(MLX).NE.IBLA)GO TO 336
60300		MLX=MLX+1
60400		GO TO 436
60500	636	IF(N.NE.ISEMI)GO TO 936
60600	336	IF(ISUB.EQ.104)GO TO 104
60700		IF(ISUB.GT.3)GO TO 1899
60800	   	GO TO (101,102,103),ISUB
60900	C             PAR  MOV LIST  OTHERS
61000	936	IF(N.NE.IDOT)GO TO 736
61100		L=INP(JD+1)
61200		DO 836 KL=1,10
61300	836	IF(L.EQ.IDAT(KL))GO TO 236
61400		IF(CODE.EQ.-22.)INP(JD)=1
61500		GO TO 236
61600	C   CHANGES DOTTED RHYTHMS TO '1'S.
61700	736	IF(N.NE.'*')GO TO 136
61800		IAMP=-1
61900		INP(JD)=IBLA
62000	C  ******* WAS ISEMI ****** WHY?
62100	136	IF(N.NE.IQT)GO TO 236
62200		DO 1361 K=JD+1,72
62300		IF(INP(K).NE.IQT)GO TO 1361
62400		JD=K+1
62500		GO TO 975
62600	C   SKIPS MATE∧aP⊂⊂IN QUOTES
62700	1361	CONTINUE
62800		GO TO 99
62900	C   OPEN QUOTES
63000	236	JD=JD+1
63100		IF(JD.LT.73)GO TO 975
63200		TYPE 1236
63300		GO TO 99
63400	1236	FORMAT(' MISSING SEMICOLON')
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00500	C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600		JA=-1
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.EQ.'R')GO TO 2337
01000	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01100		IF(N.EQ.ID)GO TO 7720
01200		GO TO 99
01300	1	CALL SCANR
01400	 	LPAR=VX1
01500		IJ=LPAR
01600		IF(QX.GE.0)GO TO 5703
01700		IJ=LPAR+4
01800	C  SETS UP PARAM FOR QUAD CALL
01900		V(I)=IJ+LK*10000
02000		V(I+1)=2*ALL
02100	C  TEST "ALL" FEATURE HERE!!!!!!!
02200	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300		V(I+2)=QX
02400		I=I+3
02500		QX=0.
02600	5703	IAMP=0
02700		IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800		IF(LPAR.EQ.32)LPAR=1
02900		V(I)=LPAR+LK*10000
03000	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100		IJ=I+1
03200		I=I+4
03300		ITMP=0
03400		CODE=0
03500		NFLG=1
03600		ML=IZ+M
03700	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
03800	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
03900	C  QU=QUADC  QUX=QUADX 
04000	5702	ML=ML+1
04100		IF(ML.GT.72)GO TO 99
04200		N=INP(ML)
04300		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400		NL=INP(ML+1)
04500		JA=-1
04600		ISUB=0
04700		IF(N.EQ.IXX)GO TO 2703
04800		IF(N.EQ.'R')GO TO 6702
04900		IF(N.EQ.IF)GO TO 8702
05000	CC	IF(N.EQ.ID)GO TO 1703
05100	4005	JA=0
05200		IF(N.EQ.IEN)GO TO 6005
05300		IF(N.EQ.'M')GO TO 703
05400		IF(N.EQ.'L')GO TO 2720
05500		IF(N.EQ.ISS)GO TO 6703
05600		IF(N.EQ.ITT)GO TO 4018
05700		IF(N.EQ.IQT)GO TO 5720
05800		IF(N.EQ.ISEMI)GO TO 2018
05900		IF(N.EQ.IPP)JA=-1
06000	C  FOR /P5  P3/
06100		CALL SCANR
06200		IF(ISUB.EQ.8)GO TO 8
06300		I=I+JJ
06400		V(IJ+1)=NNUM+DF
06500		IF(JJ.EQ.1)GO TO 4006
06600	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
06700		IF(NNUM.NE.-2)GO TO 5006
06800		IX=IJ+3
06900		DO 2006 K=2,JJ,3
07000	CC    X=VX(K)
07100	CC    Y=VX(K+1)
07200	CC    IF(X.GT.Y)VX(K)=X+.999
07300	CC2006      IF(Y.GT.X)VX(K+1)=Y+.999
07400	2006  CALL RANR(VX,K)
07500	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
07600	5006	IX=IJ+2
07700		DO 6006 K=1,JJ
07800	6006	V(IX+K)=VX(K)
07900		V(IX+JJ-2)=1.
08000	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
08100		GO TO 3013
08200	4006	IF(JA)VX1=VX1/100.+9999.
08300	C  CHANGES /P5 P3/ TO /P5 9999.03/
08400		V(I-1)=VX1
08500		GO TO 3013
08600	6702	IF(NL.EQ.IE)GO TO 2703
08700	C   JUMP IF "REP"
08800		IF(NL.EQ.ITT)GO TO 4018
08900	C   JUMP IF "RTAP"
09000		CODE=-22
09100		IF(NL.EQ.'L')CODE=-46.0
09200	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09300		IF(NL.NE.IEN)GO TO 1016
09400	C   JUMP IF NOT "RNOTES"
09500		JA=0
09600	C   FOR SCANR
09700		CODE=-36.
09800		GO TO 1016
09900	6005	CODE=-33
10000		IF(NL.NE.'U')GO TO 1016
10100		CODE=-44.
10200	1610	JA=-1
10300		GO TO 1016
10400	8702	CODE=-35
10500		IF(NL.EQ.'U')GO TO 1016
10600		ML=ML+1
10700		CALL SCANR
10800	7	V(IJ+1)=CODE+DF
10900		V(IJ+2)=1.
11000		V(I)=VX1+85.
11100		GO TO 7703
11200	703	BW=V(IJ-2)
11300		IC=0
11400		DO 7031 K=ML+1,72
11500		IF(INP(K).EQ.ISEMI)GO TO 8031
11600	7031	IF(INP(K).EQ.IXX)IC=-1
11700	C****************  JUNE 1,71   X 4
11800	8031	I=I-1
11900		V(I)=0
12000	C ********* FEB. 15,71
12100		X=-9900.-BY
12200		IF(BY.EQ.0)X=-9900.-BG(LK)
12300	   	IF(BW.EQ.X)GO TO 8005
12400		IF(BW.NE.-9900.-BY)GO TO 1102
12500		V(IJ-2)=X
12600		GO TO 8005
12700	1102	V(IJ)=V(IJ-1)
12800		V(IJ-1)=X
12900		IJ=IJ+1
13000		I=I+1
13100	8005	LP=IJ-1
13200		BW=-9900.-X
13300		ISUB=2
13400		IZ=-1
13500	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13600	4703	GO TO 1299
13700	102	IF(IZ.LT.0)GO TO 2102
13800		BW=V(ICT)+BW
13900		V(I)=-9900.-BW
14000		V(I+1)=V(LP)
14100		V(I+2)=(JJ+2)*ALL
14200		V(I+3)=CODE+DF
14300		I=I+4
14400		IZ=1
14500	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
14600	C   ROUND-OFF NONSENSE
14700	2	VX3=-9900.
14800		VX2=VX3 
14900		CALL SCANR
15000		IF(JJ.EQ.4)GO TO 99
15100		IF(VX3.NE.-9900.)GO TO 3102
15200		IF(VX2.NE.-9900.)GO TO 4102
15300		VX2=VX1
15400		VX1=10000.
15500	4102	VX3=VX2
15600		JJ=3
15700	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
15800	3102	IF(IZ.GE.0)GO TO 3006
15900		V(IJ)=(JJ+2)*ALL
16000	C  WORD COUNT
16100		CODE=-55.
16200		IF(JJ.NE.3)CODE=-57.
16300	C  THIS IS NOW OUT, FEB 15,70.  -10000. MEANS 'NOTES AT BG TIME 0'
16400		IF(NFLG)CODE=CODE-1.
16500		IF(IC)CODE=-59.
16600	C****************  JUNE 1,71   
16700	C  CODE=-56 OR -58 FOR NOTES.
16800		V(IJ+1)=CODE+DF
16900		IZ=0
17000	3006	IF(NFLG.EQ.1)GO TO 5005
17100	CC    IF(VX2.GT.VX3)VX2=VX2+.999
17200	CC    IF(VX3.GE.VX2)VX3=VX3+.999
17300	CC    IF(JJ.EQ.3)GO TO 5005
17400	CC    IF(VX4.GT.VX5)VX4=VX4+.999
17500	CC    IF(VX5.GE.VX4)VX5=VX5+.999
17600	      CALL RANR(VX,2)
17700	      IF(JJ.NE.3)CALL RANR(VX,4)
17800	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
17900	5005	ICT=I
18000	  	IJ=IJ+1
18100		DO 1006 K=1,JJ
18200	1006	V(IJ+K)=VX(K)
18300		I=I+JJ  
18400		IJ=I+2
18500		IF(IAMP.EQ.0)GO TO 1299
18600	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18700		V(I)=-9900.-BY
18800		GO TO 8703
18900	CC1703	IF(NL.NE.IF)GO TO 4005
19000	CC	CODE=-45.
19100	CC	GO TO 1016
19200	C   ABOVE IS**** WAS ***** FOR 'DF'  (DUTY FACTOR)
19300	7703	V(IJ)=4.*ALL
19400	8703	I=I+1
19500		GO TO 4773
19600	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
19700	6703	CODE=-12.
19800		IF(INP(ML+3).EQ.'L')CODE=-11.
19900		V(IJ)=2.*ALL
20000		V(IJ+1)=CODE+DF
20100		I=I-1
20200		GO TO 4773
20300	4018	CNT(LK)=-9900.-BY
20400		P(LK)=V(I-4)
20500		JREAD=3
20600		GO TO 4400
20700	C   JUMPS TO READER
20800	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20900		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21000	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
21100		IF(NL.NE.ITT)GO TO 2338
21200		CODE=-23.
21300		GO  TO 1016
21400	2338	I=I-4
21500		GO TO 4773
21600	3018	CNT(KZY)=-9900.
21700		JREAD=4
21800		GO TO 4400
21900	444	IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
22000		IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
22100		P(KZY)=980000.
22200		GO TO 2308
22300	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22400	C  'REP'
22500	2703	ML=ML+1
22600		VX1=0
22700		VX2=0
22800		VX3=0
22900		IF(N.EQ.IXX)GO TO 2704
23000		INP(ML)=IBLA
23100		INP(ML+1)=IBLA
23200	C  WIPES OUT 'EP' IN 'REP'
23300	2704	CALL SCANR
23400	 	V(IJ)=3.
23500		V(IJ+1)=-66.0
23600		IF(VX1.EQ.32.)VX1=1.
23700		IF(VX1.EQ.0)VX1=LPAR
23800		IF(VX2.EQ.0)VX2=LK-1
23900		V(IJ+2)=VX1+VX2*10000.
24000		KL=VX2
24100		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24200		IF(VX3.EQ.0)GO TO 4773
24300		L=VX3
24400		ML=LK+1
24500		DO 1018 KL=ML,L
24600		IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24700		IF(DUR(KL))DUR(KL)=DUR(LK)
24800	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
24900		V(I)=V(I-4)+10000.
25000		V(I+1)=3.
25100		V(I+2)=-66.
25200		V(I+3)=V(I-1)
25300	1018	I=I+4
25400		GO TO 4773
25500	
25600	2018	IF(DF.EQ.0)GO TO 20181
25700	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25800		V(IJ+1)=-201.
25900		V(IJ+2)=1.
26000		V(IJ+3)=0
26100		GO TO 7703
26200	20181	V(IJ)=3.
26300		V(IJ+1)=-66.
26400		V(IJ+2)=NW+LK*10000
26500		GO TO 4773
26600	C  READS /P5  .3 "ABC" .7 "XYZ"/
26700	
26800	8 	V(IJ+1)=-77.+DF
26900	C  DF HAS SUBR CALL INFO
27000		I=I+1
27100		VX(JJ-1)=1
27200	C  FOR RAND. SINGLE LITS.
27300		DO 3722 K=1,JJ,2
27400		V(I)=VX(K)
27500	3722	I=I+1
27600		V(IJ+2)=JJ/2
27700		V(IJ+3)=I
27800		DO 4722 K=2,JJ,2
27900		KN=I
28000		I=I+1
28100		L=VX(K)
28200		DO 6722 KL=L,72
28300		IF(INP(KL).EQ.IQT)GO TO 4722
28400		IV(I)=INP(KL)
28500	6722	I=I+1
28600	4722	V(KN)=I-KN-1
28700		V(IJ)=(I-IJ)*ALL
28800		GO TO 4773
28900	2720	QTS=0
29000		ISUB=104
29100		GO TO 1299
29200	
29300	104	DO 6721 K=ML,72
29400		JC=K+1
29500		IF(INP(K).EQ.IQT)GO TO 7721
29600	6721	IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29700	C  FOR REPEAT OF ITEM BY SLASH
29800	7232	DO 7231 K=I-1,1,-1
29900		IF(ABS(V(K)).GT.72.)GO TO 7231
30000		NL=V(K)
30100		DO 7230 KL=K,K+NL
30200		V(I)=V(KL)
30300	7230	I=I+1
30400		GO TO 27222
30500	7231	CONTINUE
30600	
30700	5720	IAMP=-1
30800		JC=ML+1
30900	C  FOR SINGLE 'LIT' ITEMS.
31000	7721	DO 1722 KL=JC+1,72
31100		IF(INP(KL).NE.IQT)GO TO 1722
31200		JD=KL-1
31300		ML=KL+1
31400		NL=KL-JC
31500	C   EXTENT OF LIT ITEM IS FOUND
31600		GO TO 8721
31700	1722	CONTINUE
31800	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
31900	8721	V(I)=NL
32000		DO 9721 K=JC,JD
32100	C   PUTS ITEM IN "IV" ARRAY
32200		I=I+1
32300	9721	IV(I)=INP(K)
32400		I=I+1
32500	27222	IF(IAMP.EQ.0)GO TO 1299
32600	2722	V(I)=999.
32700		QTS=-1.
32800	27221	V(IJ+1)=-88.+DF
32900		V(IJ)=(I-IJ+1)*ALL
33000		IJ=IJ+2
33100		V(IJ)=IJ+1
33200		I=I+1
33300		ISUB=1
33400		GO TO 1299
33500	
33600	7720	V(I)=LK
33700		V(I+1)=3.
33800		V(I+2)=-67.
33900		ML=ML+4
34000		CALL SCANR
34100	 	V(I+3)=VX1
34200		I=I+4
34300		L=VX1
34400		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34500		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34600		GO TO 4773
34700	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
34800	142	FORMAT(I,15A5) 
34900	1301	FORMAT(15A5) 
35000	2773	FORMAT(I,A5,72A1) 
35100	2114  FORMAT(I,72A1)
35200	300	FORMAT(I,3F,A1)
35300	301	FORMAT(3F,A1)
35400	6 	KB=KB+1
35500		IF(JED.GT.0)JED=0
35600		IF(J.EQ.'INSER')GO TO 1340
35700	      OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
35800	      GO TO 340   
35900	1340	X=VX1
36000		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
36100		OTH(KB,1)=X
36200		GO TO 1338
36300	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36400	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
36500	C   - BEGIN LINE WITH  <,END WITH ; 
36600	C   UP TO 75 CHARACTERS MAY BE TYPED.     
36700	340      IF(VX3.NE.2)GO TO 1338 
36800		IF(ITYP.GE.0)GO TO 449
36900		JREAD=5
37000		GO TO 4400
37100	445	OTH(KB,3)=1.
37200		IF(LN.EQ.0)GO TO 447
37300		REREAD 300,K,OTH(KB,2)
37400		GO TO 1447
37500	447	REREAD 301,OTH(KB,2)
37600	1447	IF(JED)GO TO 2308
37700	3445	TYPE TEDIT
37800		ACCEPT 77732,K
37900		IF(K.EQ.'G')JED=-1
38000		IF(J.EQ.'INSER')GO TO 3446
38100		IF(K.NE.'Y'.OR.JED)GO TO 2308
38200	449	TYPE TPALN
38300		ACCEPT 301,OTH(KB,2)
38400		IF(JED)WRITE(21,301) OTH(KB,2)
38500		GO TO 2308
38600	
38700	1338	IF(ITYP.GE.0)GO TO 1449
38800		JREAD=6
38900		GO TO 4400
39000	446	IF(LN.EQ.0)GO TO 448
39100		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
39200		GO TO 1446
39300	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
39400	1446	IF(JED)2446,3445,2446
39500	3446	IF(K.NE.'Y'.OR.JED)GO TO 2446
39600	1449	TYPE TPALN
39700		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
39800		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
39900	2446	X=OTH(KB,2)
40000		IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40100		IF(X.EQ.'*')KB=KB-1
40200	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
40300	C   LAST LINE HAS '*' IN COLUMN 1.
40400		GO TO 2308
40500	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
40600	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
40700	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
40800	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
40900	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41000	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41100	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
41200	1899	CALL SCANR
41300		GO TO(1,2,3,4,5,6),ISUB
     

00100	1106	KTMP=1
00200		TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2/TP
01300		V(I+4)=VX3/TP
01400		I=I+5
01500		BY=BW
01600	C  SEPT 18, 70
01700		IF(VX1.EQ.0)GO TO 2308
01800		BW=BW+VX1
01900		V(I)=-9900.-BW
02000		I=I+1
02100		CALL BGSORT(BW)
02200	9003	IF(IAMP)GO TO 4003
02300	2016	VX3=0
02400		VX2=0
02500		GO TO 1299
02600	5	IF(VX2.NE.0)GO TO 105
02700	C  'TEMPO/120*;'  OR  'TEMPO/1.5 72*;'  IS OK.
02800		VX2=VX1
02900		VX1=0
03000	105	IF(VX3.EQ.0)VX3=VX2
03100		IF(VX2.LT.11.)TP=1.
03200		IF(J.EQ.ITMPO)GO TO 3019
03300	  	PCH(1,KTMP)=VX1
03400		PCH(2,KTMP)=VX2
03500		PCH(3,KTMP)=VX3
03600	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
03700		KTMP=KTMP+1
03800		IF(IAMP.EQ.0)GO TO 2016
03900	4003	VX1=0
04000		IAMP=0
04100		VX2=VX3
04200		IF(J.EQ.ITMPO)GO TO 3019
04300		PCH(1,KTMP)=0
04400		PCH(2,KTMP)=VX2
04500		PCH(3,KTMP)=VX2
04600	C   MM CAN BE FROM 11 UP  ITMPO FACTOR FROM 10 DOWN.  
04700	C   UP TO 30 ITMPO CHANGES MAY BE MADE.   
04800	
04900	1016      IA=I    
05000	      IZ=1  
05100	3100	V(I-2)=CODE+DF
05200	      ISUB=3     
05300	5016	IF(IAMP.GE.0)GO TO 1299
05400	117	IF(IZ-2)3013,9004,9004
05500	103	K=INP(ML)
05600		IF(K.EQ.ITT)GO TO 1106
05700		IF(K.EQ.ISEMI)GO TO 1014
05800		IF(K.NE.IBLA) GO TO 1899
05900		ML=ML+1
06000		GO TO 103
06100	C@@@@@@@@ MAY 13,71 @@@@@@
06200	C**********FEB 19,71
06300	C  ABOVE 
06400	3      IF(VX1.EQ.-99.)GO TO 4022
06500		IF(CODE.EQ.-22.)GO TO 2017
06600	C************ MAY 19,71
06700	  	IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06800	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06900	2017	IF(VX1.EQ.10000.)GO TO 17
07000	      VX1=4./VX1
07100		IF(JJ.NE.1)GO TO 2014
07200		V(I)=VX1
07300		GO TO 114
07400	
07500	1217	IF(VX1.EQ.10000.)GO TO 114
07600	C    FOR "FINE" IN LIST
07700	CC    IF(CODE.EQ.-46.)GO TO 4217
07800	CC    IF(VX1.GT.VX2)V(I)=VX1+.999
07900	CC    IF(VX2.GT.VX1)VX2=VX2+.999
08000	C   ABOVE EXTENDS RANGE TO GIVE HIGHEST NOTE A CHANCE
08100	CC4217      V(I+1)=VX2
08200	      V(I+1)=VX2
08300	      IF(CODE.EQ.-36.)CALL RANR(V,I)
08400	2217	I=I+1
08500	C  SETS UP STRING OF RAND SELECTIONS
08600		GO TO 114
08700	3217	V(I)=V(I-2)
08800		V(I+1)=RB
08900	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
09000		GO TO 2217
09100	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
09200	
09300	2014	DO 9006 L=2,JJ
09400		IF(VX(L).EQ.0)GO TO 17
09500	9006	VX1=4./VX(L)+VX1
09600		JJ=1
09700	17	V(I)=VX1
09800		IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
09900	C  JUMP IF STRING OF RAND SELECS.
10000		IF(JJ.EQ.1)GO TO 114
10100		L=VX(JJ)-1
10200		X=V(I)
10300		NL=I+1
10400		I=L+I
10500		DO 1017 K=NL,I
10600	1017	V(K)=X
10700	C   ADDS UP TOTAL   OF NOTES IN SEQ.
10800		IZ=IZ+L
10900		GO TO 114
11000	1014	IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
11100		V(I)=RB
11200	C   RB SAVES IT FOR SLASH REPEAT
11300	114      RB=V(I)     
11400	      I=I+1 
11500	      IZ=IZ+1     
11600	      GO TO 5016    
11700	4022      JC=VX2+.3
11800	      JD=VX3-.5
11900		IF(JJ.EQ.2)JD=1
12000	C********* MAY 19,71   ----MANY LINES ABOVE.
12100	      IZ=IZ+JC*JD 
12200	C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
12300	      DO 1005 K=1,JD    
12400	       NL=I+JC-1  
12500	      DO 2005 L=I,NL    
12600	2005  V(L)=V(L-JC)
12700	1005      I=I+JC  
12800		RB=V(NL)
12900	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
13000	      GO TO 5016  
13100	
13200	9004	IF(ITMP.EQ.0)GO TO 3013
13300	C*********** JUNE 1,71
13400		IZ=IZ-1
13500	C***** JAN. 1974
13600	      KA=1  
13700	      IC=1  
13800	      K=0   
13900		J=1
14000	      Z=0   
14100	      RC=0  
14200	9007	Y=PCH(3,IC)/TP
14300		X=PCH(2,IC)/TP
14400	      Z=PCH(1,IC) 
14510		CALL SQYY(YY,X,Y,Z)
14700		XT(1)=X
14800	      XA=RA 
14900	      RD=1  
15000	      RB=0  
15100	      ZZ=Z  
15200	7020      RA=V(IA+K)    
15300		IF(RA.EQ.10000.)GO TO 3013
15400	4020  RD=1  
15500	      IF(RA.LT.0)RD=-1. 
15600	      RA=RA*RD    
15700	      IF(KA.EQ.0)RA=RA-RC     
15800	      W=RA  
15900	      RB=W  
16000	      IF(W.LE.Z)GO TO 2020    
16100	      IF(Z.NE.0)GO TO 3020    
16200	      RA=RA/Y     
16300	      RB=-1.
16400	      RC=0  
16500	      GO TO 8020  
16600	3020      W=Z     
16700	      RC=W+RC     
16800	      GO TO 24    
16900	2020      RC=0    
17000	24	IF(X.NE.Y)GO TO 424
17100		RA=W/X
17200		GO TO 8020
17300	C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
17400	C   BG TIME OF NOTE. CHN=TBG.
17500	424	RAX=XT(J)
17600		RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
17700		XT(J)=RAX+YY*RA
17800	8020      IF(KA.EQ.0)RA=RA+XA 
17900	      KA=1  
18000	      IF(RC.NE.0)GO TO 1011   
18100	      IF(T5.EQ.1)GO TO 8203   
18200	      V(IA+K)=RA*RD     
18300	      IF(K.EQ.IZ)GO TO 3013     
18400	C*********** JUNE 1,71
18500	1011      IF(T5.EQ.1)GO TO 2011     
18600	      K=K+1 
18700	      IF(ZZ.NE.0)Z=Z-W  
18800	      IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020     
18900	      IC=IC+1     
19000	      IF(RB.EQ.W)GO TO 9007
19100	      KA=0  
19200	      K=K-1 
19300	      GO TO 9007     
19400	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
19500	C     ML=I-1
19600	C     ML=I-1
19700	C*********** MAY 13,71 ********
19800	3013	X=I-IJ
19900		V(IJ+2)=X-3.
20000		V(IJ)=X*ALL
20100		IF(CODE.NE.-35)GO TO 4773
20200		M=IJ+3
20300	C   SETS NUMBERS FOR FUNCS.
20400		DO 313 K=M,I-1
20500	313	IF(V(K).LT.85.)V(K)=V(K)+85.
20600		GO TO 4773
20700	
20800	2011      XA=RA   
20900		IF(K.GT.1)GO TO 9020
21000		K=I-6
21100	      ZPAR=-9900.-CHN-ZZ
21200	      DO 3011 KL=8,I     
21300	      IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020    
21400	3011      K=K-1
21500	9020      W=ZZ  
21600		IF(V(K+3))K=K+3
21700	C   ABOVE IS FOR TYPED IN TEMPO CHANGES
21800		KA=K+3
21900	      ZZ=V(KA)
22000	C   DUR OF NEXT TEMPI
22100		X=V(KA+1)
22200		Y=V(KA+2)
22300	213      KA=0  
22400	      Z=ZZ  
22500		CALL SQYY(YY,X,Y,Z)
22700	      CHN=CHN+W   
22800		XT(J)=X
22900	      IF(KA.EQ.1)Z=0    
23000	      RA=PR 
23100		KA=0
23200		K=K+3
23300		GO TO 4020
     

00100	2337	T=0
00200		DO 1107 K=1,30
00300	1107	PL(K)=1.
00400	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
00500		IF(ITYP)GO TO 23371
00600		END FILE 21
00700		DATA ENFI /25H(' INPUT ON FOR21.DAT'/) /
00800		TYPE ENFI
00900	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
01000	23371	IF(SOS)WRITE(JOUT,902)
01100	C   WRITES A BLANK LINE
01200		NWZZ=0
01300		IAMP=0
01400		IT3=0
01500		K=1
01600	      IX=0  
01700		BG(NINS+1)=19999.
01800	4011	IF(CNT(K))GO TO 5011
01900	6011	IF(K.EQ.KZY)GO TO 4337
02000		K=K+1
02100		GO TO 4011
02200	5011	L=V(I-1)/(-9900.)
02300		IF(L.EQ.1)I=I-1
02400		V(I)=CNT(K)
02500		V(I+1)=P(K)
02600		V(I+3)=-44.
02700		I=I+5
02800		IF(P(K).EQ.980000.)I=I-4
02900		KL=I
03000		REWIND 1
03100		ICT=IPT(K,1)
03200		CALL IFILE(1,ICT)
03300	9011	L=I+6
03400		READ(1,7011)(V(M),M=I,L)
03500	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
03600		IF(V(L).EQ.999.)GO TO 8011
03700		I=L+1
03800		GO TO 9011
03900	8011	IF(P(K).NE.980000.)GO TO 6337
04000		DO 7337 K=L,I,-1
04100	7337	IF(V(K).NE.999.)GO TO 8337
04200	8337	I=K-1
04300		V(I)=0
04400		V(I+1)=V(K)
04500		V(I+2)=V(K)
04600	C   K WAS I-1 ABOVE.
04700		I=I+3
04800		V(KL+1)=I-KL-1
04900	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
05000		GO TO 4337
05100	6337	DO 5337 M=I,L
05200		KN=M
05300	5337	IF(V(M).EQ.999.)GO TO 3337
05400	3337	I=KN
05500		KN=I-KL
05600		V(KL-1)=KN
05700		V(KL-3)=KN+3
05800		GO TO 6011
05900	7011	FORMAT(7F)
06000	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
06100		V(I)=-19899.
06200	      PP1=0
06300	      T6=10000.   
06400	      DO 2118 K=1,NINS  
06500		ROFF(K)=0
06600	C********* FEB 17,71
06700		M=NP(K)
06800	      IT(K)=0 
06900		IPT(K,31)=0
07000		NCNT(K,31)=1
07100		DO 2118 L=1,M
07200		NCNT(K,L)=1
07300	2118	IPT(K,L)=0
07400		DO 5013 K=1,IXIN
07500	5013	X=RAND(0.0,0.0)
07600		REWIND 1
07700		IF(MX)CALL OFILE(1,ISLAC)
07800	      NW=1    
07900		NWX=0
08000	      TDUR=0
08100		A=0
08200	      T2=1. 
08300	      T4=1. 
08400	      T5=0  
08500		J=1
08600	      MK=0  
08700	C   IS THE ABOVE NEEDED?
08800		IF(MX.NE.3)GO TO 40021
08900		K=4
09000	CC10023	N=V(K)/-11.
09100	10023	N=AMOD(V(K),100.0)/-11.
09200	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
09300		IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
09400		1 .V(K-2).LT.10000.)GO TO 10021
09500		J=V(K+1)
09600		IF(J.EQ.1)GO TO 10024
09700		IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
09800		N=V(K-2)
09900		L=N/10000
10000		M=N-L*10000
10100		TYPE 10022,INST(L),M,J
10200	10024	K=K+ABS(V(K-1))
10300	10021	K=K+1
10400		IF(K.LT.I)GO TO 10023
10500	40021	IF(MZ.NE.-4)GO TO 1002
10600		N=1
10700	40022	K=N+1
10800		IF(N.GT.I)CALL EXIT
10900		X=V(N)
11000		IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
11100		IF(X.GE.0)GO TO 40023
11200		PRINT 4002,X
11300		N=N+1
11400		GO TO 40022
11500	40024	J=N+1
11600		GO TO 40025
11700	C  FOR 'SECTIONS'
11800	40023	J=ABS(V(K))+K-1
11900	40025	PRINT 4002,(V(K),K=N,J)
12000		N=J+1
12100		GO TO 40022
12200	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
12300	4002  FORMAT(10F12.3)
12400	1002	IF(IDALL)GO TO 600
12500		X=DUR(IDALL)
12600		DO 2002 K=1,NINS
12700	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000		IV(K-1)=0
03100	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200		RD=V(KL+2)+9900.
03300		DO 6150 L=KL+2,I
03400		M=V(L)/(-9900.)
03500		IF(M.NE.1)GO TO 6150
03600		RA=RB+RD-V(L)-9900.
03700		V(L)=-9900.-RA
03800	C  UPDATES BG TIMES INSIDE SECTION.
03900		CALL BGSORT(RA)
04000	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04100	C  UPDATES LIST OF CHANGE TIMES.
04200	6150	IF(V(L).EQ.-299.)GO TO 160
04300	5150	CONTINUE
04400	160	IL=1
04500		GO TO 3723
04600	C***********  ABOVE IS FOR 'SECTION' REPEATS
04700	4150	LK=RB/10000.+.2
04800		IF(LK.GE.98)GO TO 7700
04900		LP=RB-LK*10000
05000	C   LK=INST #   LP=PARAM #
05100		LN=IPT(LK,LP)
05200		IPT(LK,LP)=IL+2
05300		IF(RD.EQ.-66.)GO TO 726
05400		IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500		IF(RD.EQ.-23)GO TO 6700
05600	
05700	2727	ML=IPT(LK,LP)
05800		IF(MOT.GT.0)GO TO 3727
05900	C  USE NEG WDCNT FOR 'ALL'
06000		DO 4727 KL=LK+1,NINS
06100		IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200		IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300		NCNT(KL,LP)=10000
06400	4727	IF(DUR(KL))DUR(KL)=1000.
06500	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700	CC	GO TO 2150
06800	C ABOVE CHANGED TO BELOW DEC.6,72.  'ALL' WAS OMITTING 1ST ITEM.
06900		GO TO 727
07000	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07100	3727	IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
07200	CC ************  JAN 20 ***********
07300		DO 1727 L=1,NINS
07400		DO 1727 KL=1,NP(L)
07500		IF(LN.NE.IPT(L,KL))GO TO 1727
07600		NCNT(L,KL)=10000
07700	C ******* JAN 29,70
07800		IPT(L,KL)=ML
07900	C RESETS POINTERS FOR DUPL AND REP INSTS.
08000	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08100	1727	CONTINUE
08200	727	NCNT(LK,LP)=10000
08300	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08400	2150	IF(MOT)MOT=-MOT
08500		IL=IL+MOT+1
08600	3150	IF(V(IL))GO TO 3723
08700		GO TO 729
08800	726	RB=V(IL+3)
08900		K=RB/10000.
09000		L=RB-K*10000
09100		IPT(LK,LP)=-(K+(L-1)*KZY)
09200		GO TO 2727
09300	3726	LK=V(IL)
09400		M=V(K+1)
09500		KL=NP(M)
09600		DO 4726 L=1,KL
09700		IPT(LK,L)=IPT(M,L)
09800		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09900	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
10000	4726	CONTINUE
10100		IPT(LK,31)=IPT(M,31)
10200		K=0
10300		GO TO 2150
10400	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10500	6700	KL=IL+V(IL+1)+1.3
10600		RC=V(K-2)
10700	1770	IF(V(KL))GO TO 700
10800	2700	KL=KL+V(KL+1)+1.3
10900		GO TO 1770
11000	700	KL=KL+1
11100		IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
11200		KL=KL+3
11300		KN=IL+3
11400		LN=V(KN)+.3
11500		DO 3700 L=1,LN,2
11600		RA=V(L+KN)
11700		KA=V(L+KN+1)+.3
11800		RB=0
11900		DO 4700 LP=1,KA
12000	4700	RB=RB+V(KL+LP)
12100		DO 5700 LP=1,KA
12200	5700	V(KL+LP)=V(KL+LP)/RB*RA
12300		V(KL+KA)=V(KL+KA)+.00030
12400	3700	KL=KL+KA
12500		GO TO 2150
12600	
12700	C  BELOW FOR 'TEMPO' SETUP
12800	7700	T2=V(IL+4)
12900		T1=V(IL+3)
13000		TBG=Y
13100		TDUR=V(IL+2)
13200	CC	AC=2.*TDUR/(T1+T2)
13300	CC	AC=2.*(TDUR-T1*AC)/AC**2
13350		CALL SQYY(AC,T1,T2,TDUR)
13400	8700	IF(TDUR.EQ.0)TDUR=10000.
13500		T5=1.
13600		T6=TBG+TDUR
13700		IT3=1.
13800		IF(LK.EQ.98)IT3=IL+2
13900		T4=1.
14000		GO TO 2150
14100	C*************** ANY WDCNTS DOWN FROM HERE. *********
14200	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14300	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14400		RA=BT
14500		K=IL-1
14600	2726	V(K)=-9900.-RA
14700		ISUB=-1
14800		L=K+5
14900		RB=V(L)+V(L-1)
15000		V(L-1)=RA
15100		K=K+V(K+2)+2
15200		IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
15300		1 V(K).NE.-9900.-RB)GO TO 2727
15400		RA=RA+V(L)
15500		CALL BGSORT(RA)
15600		GO TO 2726
15700	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
15800	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
15900	732	DO 2606 K=NW,NWZ
16000	2606	BNW(K)=BNW(K+1)
16100		NWZ=NWZ-1
16200		IF(NWZ.EQ.0)GO TO 2111
16300		IF(NWZZ.EQ.1)GO TO 5111
16400		NWZZ=1
16500		IF(NWZ.EQ.1)GO TO 1111
16600		DO 3111 K=1,NWZ
16700		IF(BNW(K).LT.1000.)GO TO 3111
16800		X=BNW(NWZZ)
16900		BNW(NWZZ)=BNW(K)
17000		BNW(K)=X
17100		NWZZ=NWZZ+1
17200	3111	CONTINUE
17300	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17400		L=NWZZ+1
17500		X=BNW(NWZZ)
17600		DO 4111 K=L,NWZ
17700		IF(BNW(K).GT.X)GO TO 4111
17800		RA=BNW(K)
17900		BNW(K)=X
18000		X=RA
18100	4111	CONTINUE
18200		BNW(NWZZ)=X
18300		GO TO 1111
18400	111      FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18500		1'V ARRAY=',I4,'/2000   TEMPO FACTOR=',F6.2,4X,
18600		1'RANDOM NUMBER =',I6/)
18700	1023	FORMAT(/'  <  ',A5,'.DAT '/1XA5)
18800	C********** BELOW IS FOR 'SECTIONS'
18900	9150	FORMAT(/3X'******* SECTION ',A1)
19000	2111	NWZ=-1
19100	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19200	1111	IF(MZ.EQ.0)GO TO 1601
19300	      IF(NWX.NE.1)GO TO 1486
19400	      WRITE(JOUT,111),ISLAC,IFLNM,I,TF,IXIN
19500	C*********** JUNE 1,71
19600	C********** BELOW IS FOR 'SECTIONS'
19700	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19800		K=NWX-1
19900	C*********** JUNE 1,71
20000	          IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
20100		IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
20200	C*********** JUNE 1,71    X 3     K'S
20300	
20400	      DO 602 K=1,NINS   
20500	48	LK=INST(K)
20600	C*********** JUNE 1,71
20700	  	IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
20800	CCNOV,72	IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
20900		NCNT(K,31)=1
21000		IJ=IPT(K,31)
21100		X=0
21200		IF(IJ.NE.0)X=V(IJ+2)
21300	      WRITE(JOUT,5396),LK,X
21400		X=DUR(K)
21500	      IF(X.GT.10000.)GO TO 83 
21600	      WRITE(JOUT,8396),X     
21700	CCNOV,72	GO TO 8826
21800		GO TO 602
21900	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
22000	7396      FORMAT('+',F5.0,' NOTES')    
22100	CCNOV,72
22200	CC4396      FORMAT(5XA5,'  % RANDOM RESTS   DUR=',F7.3,'", FROM',    
22300	CC   1F6.3,' TO',F6.3)
22400	CC485      FORMAT(5XA5,'  % RANDOM RESTS = ',F4.2)     
22500	CCNOV,72
22600	8396      FORMAT('+',F6.2,'"')   
22700	83      X=X-10000.
22800	      WRITE(JOUT,7396),X    
22900	CCNOV,72 *************************************************
23000	CC8826	IF(NCNT(K,1).NE.10000)GO TO 602
23100	CC	NCNT(K,1)=1
23200	CC	IJ=IPT(K,1)+2
23300	C********* FEB 19,71
23400	CC	IF(V(IJ)-5.)GO TO 7826
23500	CC	WRITE(JOUT,4396),LK,V(IJ-1),V(IJ),V(IJ+1)
23600	C********* FEB 19,71
23700	CC	GO TO 602
23800	CC7826	WRITE(JOUT,485),LK,V(IJ)
23900	CCNOV,72 *************************************************
24000	602	CONTINUE
24100	715	IF(IT3.NE.1.)GO TO 1602
24200		RA=T1*TP
24300		RB=T2*TP
24400	      WRITE(JOUT,6154),RA,RB,TDUR  
24500	      IT3=0  
24600	1602	IF(NWX.EQ.1)GO TO 315
24700	      IF(IT(J).EQ.-3)GO TO 1108
24800	C*********** JUNE 1,71
24900	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
25000	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
25100	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
25200	902      FORMAT(1XA5/)  
25300	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
25400	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
25500	C*********** JUNE 1,71
25600		IT(J)=IT(J)/10
25700		GO TO 1108
25800	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
25900		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
26000	1601  IF(NWX.GT.1) GO TO 1108
26100		IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
26200		IF(TF.GT.10.)TF=TF/60.
26300		TF=1000./TF
26400		DO 6015 K=1,30
26500	6015	COPY(K)=-9900.
26600	C  INITS PARAM REPRESSION FEATURE.
26700	      IF(KB.EQ.0)GO TO 9926   
26800	      ML=NINS+1   
26900	      NL=NINS+KB
27000	      DO 9826 K=ML,NL   
27100	9826      BG(K)=OTH(K-NINS,1) 
27200	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
27300	9926      DO 5015 K=1,NINS    
27400		IQ(K)=BG(K)*10000.
27500	      BG(K)=0
27600		INP(K)=0
27700	      P1(K)=0     
27800		IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
27900	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
28000	5015      CNT(K)=0
28100		IF(MX)WRITE(1,1023)ISLAC,PLAY
28200	      BW=0 
28300		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108      M=0 
00300	      JC=0  
00400		IF(NWZ)GO TO 1740
00500	C  NWZZ IS SET AT 3111 IN SORTR.
00600		DO 740 K=1,NWZZ
00700	      X=BNW(K)    
00800		IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900		IT(J)=IT(J)*10
01000	      NW=K  
01100	      GO TO 600   
01200	2740	IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300	      X=BT+PR     
01400	      NW=K  
01500		BX=CNT(J)+1.
01600	      IT(J)=-3    
01700	      GO TO 600   
01800	740      CONTINUE 
01900	      IT(J)=0     
02000	1740      IF(J.LE.NINS)GO TO 31   
02100	7021      K=J-NINS
02200	      IF(JC.GT.0)K=JC   
02300	5740      IF(PP1.LT.OP1)GO TO 1752 
02400	      IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
02500	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
02600	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
02700	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
02800		DO 17521 L=3,30
02900	17521	COPY(L)=-9900.
03000	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100	1752	BG(K+NINS)=19999.
03200		OTH(K,1)=19999.
03300	      IF(JC.GT.0)GO TO 21     
03400	31      KL=1
03500	      IF(KB.EQ.0)GO TO 2031   
03600	      DO 1031 L=1,KB    
03700		K=L
03800	      X=OTH(K,1)-1000000.     
03900	      M=X/100000. 
04000	      IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031   
04100	C   M=INST  
04200	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
04300	1031	CONTINUE
04400		IF(J.GT.NINS)GO TO 500
04500	2031      CNT(J)=CNT(J)+1   
04600	      ICT=CNT(J)  
04700	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800	      NPA=NP(J)   
04900	      PP1=P1(J)  
05000	      IF(BT.GE.DUR(J))GO TO 5174    
05100		IF(IQ(J).EQ.0)GO TO 200
05200		P2=-IQ(J)/10000.
05300		IQ(J)=0
05400		CNT(J)=-1
05500		ICT=-1
05600		GO TO 4203
05700	
05800	C   MK IS FLAG FOR RESTS
05900	200	MK=0
06000	      IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203    
06100		KN=IPT(J,1)-1
06200		IF(KN.GT.0)GO TO 12033
06300	12032	KN=JPT(-KN)
06400		IF(KN)GO TO 12032
06500		KN=KN-1
06600	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
06700	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800	12033	IJ=V(KN)
06900		IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000	C   'IABS' IS FOR -4 USED WITH 'ALL'
07100	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
07200	C******* FEB 19,71
07300		IF(Z.GT.1.)Z=1.
07400		Y=V(KN+3)
07500		X=(V(KN+4)-Y)*Z+Y
07600	C******* FEB 19,71
07700	CC******  TAKEN OUT NOV 9,72	???  IF(X.EQ.0)IPT(J,1)=0
07800		GO TO 204
07900	1203	X=V(KN+3)
08000	204	Y=RAND(0.0,1.0)
08100		IF(Y-X)MK=-1
08200	
08300	203	DF=1.
08400	C   DF=DUTY FACTOR 
08500		DO 2155 L=2,NPA
08600		ISUB=0
08700	C  WHY DOES ISUB APPEAR AT 14700/5?
08800		IDF=0 
08900	C    IDF IS DUTY FACTOR FLAG
09000		IJ=IPT(J,L)
09100	12031	IF(IJ)IJ=JPT(-IJ)
09200		IF(IJ)GO TO 12031
09300	C  FOLLOWS UP ON POINTERS TO POINTERS!
09400		PM=1.
09500		IF(IJ.GT.1)GO TO 2157
09600		P(L)=0
09700	CC	GO TO 21552
09800		GO TO 21551
09900	C 7/73
10000	2157	LN=IJ+2
10100		NM=ABS(V(IJ-1))+LN-4
10200		NL=V(IJ)
10300		IF(NL.GT.-200)GO TO 372
10400		ISUB=-1
10500		NL=NL+200
10600	C FOR SUBROUTINE FLAG
10700	372	IF(NL.GT.-100)GO TO 272
10800		IDF=-1
10900		NL=NL+100
11000	C  DEC.6,72  FINDS DUTY FACTOR PARAM
11100	272	VIJ2=V(IJ+1)
11200		KN=NL/(-11)
11300		IF(KN.EQ.0)GO TO 1100
11400		GO TO (61,62,62,62,65,65,67,68),KN
11500	1100	IF(VIJ2.EQ.1.)GO TO 1200
11600		ML=3
11700	1900	KA=1
11800		VX1=0
11900		DO 1156 K=LN,NM,ML
12000		VX(KA+1)=V(K)+VX(KA)
12100	1156	KA=KA+1
12200		X=RAND(0.0,1.)
12300		DO 1157 K=2,11
12400		IF(X.GT.VX(K))GO TO 1157
12500		KL=K-1
12600		IF(KN.EQ.7)GO TO 6157
12700		GO TO 1400
12800	1157	CONTINUE
12900	1400	LN=IJ+3*KL
13000	1462	RA=V(LN)
13100		IF(RA.EQ.10000.)GO TO 5174
13200	C   FOR "FINE" IN RLIST
13300		RB=V(LN+1)
13400		PAR=RAND(RA,RB)
13500	1300	IF(NL.NE.-1)PM=2.
13600	C  IF 2 THEN PRINTS A5
13700		GO TO 1155
13800	1200	PAR=V(IJ+2)
13900		GO TO 1300
14000	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
14100	61	IF(NL.LT.-12)GO TO 6100
14200	601	X=P2
14300	CC	IF(NL.EQ.-11)PL(L)=2.
14400	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14500		CALL SUBR
14600	C******MAY 25,71
14700	CC	IF(P(L).EQ.10000.)GO TO 5174
14800		IF(DF)GO TO 5174
14900	C  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15000	CC	PM=PL(L)
15100		IF(L.EQ.2)GO TO 4203
15200		IF(X.EQ.P2)GO TO 21552
15300		PP2=P2
15400		PR=P2
15500		GO TO 21552
15600	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15700	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15800	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15900	C  BE SET TO 'REAL TIME'.)
16000	
16100	C   NEXT IS FOR QUAD ROUTINES
16200	6100	CALL QUAD(NL)
16300		GO TO 21552
16400	
16500	C   FOLLOWING IS FOR STRINGS OF VALUES.  
16600	62      KL=NCNT(J,L)+1
16700		IF(KL.GT.VIJ2)KL=1 
16800		IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
16900	C   THIS PART FOR STRINGS OF RAND SELECTION
17000		LN=KL+IJ+1
17100		KL=KL+1
17200		IF(KL.GT.VIJ2)KL=1 
17300		NL=NL+45
17400	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
17500	162	NCNT(J,L)=KL
17600		IF(NL.GT.-22)GO TO 1462
17700	C   JUMP RAND SELECTION
17800	      PAR=V(IJ+KL+1)
17900	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18000	C************************
18100	CC DEC.6,72	IF(NL.EQ.-45)DF=PAR
18200		IF(KN.NE.3)GO TO 1155
18300	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
18400		IF(PAR.EQ.10000.)GO TO 5174
18500		PM=2.
18600		IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
18700		IF(PAR.EQ.85.)MK=-1
18800	      GO TO 5155  
18900	65	W=-9900.-V(IJ-3)
19000	C  W=BG TIME OF MOVE.
19100		X=ABS(V(IJ-1))
19200		IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
19300		Z=(BT-W)/VIJ2
19400	C  Z= % OF WAY THROUGH.
19500		IF(Z.GT.1.)Z=1.
19600		Y=V(LN)
19700		W=V(IJ+3)
19800		IF(X.EQ.7.)W=V(IJ+4)
19900		IF(NL.LT.-58)GO TO 16002
20000		PAR=(W-Y)*Z+Y
20100		IF(X.EQ.7.)GO TO 1600
20200		GO TO 1155
20300	C************** JUNE 1,71
20400	CC16002	PAR=(W-Y+1.)**Z-1.+Y
20500	C   FOR "MOVX"
20600	CC	IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
20700	C******** FEB/73
20800	CC16002	IF(W.EQ.0)W=W+.01
20810	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
20900	CC	IF(Y.EQ.0)Y=Y+.01
21000	CC	PAR=Y*((W/Y)**Z)
21010	16002	PAR=RMOVX(W,Y,Z)
21110	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21155	C  THIS NEEDS WORK!
21200		IF(X.NE.7.)GO TO 1155
21300		W=V(IJ+5)
21400		Y=V(IJ+3)
21500	CC	X=(W-Y+1.)**Z-1.+Y
21600	CC	IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
21700	CC	IF(W.EQ.0)W=.01
21800	CC	IF(Y.EQ.0)Y=.01
21900	CC	X=Y*((W/Y)**Z)
21950		X=RMOVX(W,Y,Z)
22000		GO TO 16003
22100	C  NEXT IS FOR MOVING RAND RANGES.
22200	C1600	PAR=(V(IJ+4)-Y)*Z+Y
22300	1600	W=V(IJ+3)
22400	C*********** BACK TO 65 IS NEW.   FEB. 15,71
22500		X=(V(IJ+5)-W)*Z+W
22600	C************ JUNE 1,71   
22700	16003	PAR=RAND(PAR,X)
22800		GO TO 1155
22900	67	LN=IJ+3
23000		NM=LN+VIJ2-1
23100		ML=1
23200		GO TO 1900
23300	4155	K=(PAR-9999.0)*100.+.1	
23400		P(L)=P(K)
23500		PM=PL(K)
23600		GO TO 21551
23700	C   ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
23800	6157	LN=V(LN-1)
23900		DO 1068 K=1,KL
24000	1068	IF(K.LT.KL)LN=LN+V(LN)+1
24100	2068	PM=LN+1
24200		PAR=LN+V(LN)
24300		GO TO 5155
24400	68	KL=NCNT(J,L)
24500		IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
24600		PM=KL+1
24700		PAR=PM+V(KL)-1
24800		KL=PAR+1
24900		IF(V(KL).EQ.10000.)DUR(J)=BT
25000	C  'END' OR 'FINE' IN 'LIT' LIST.
25100		IF(V(KL).EQ.999.)KL=IJ+2
25200		NCNT(J,L)=KL
25300		GO TO 5155
25400	C ******* JAN 20  *************
25500	1155	IF(PAR.EQ.10000.)GO TO 5174
25600	C  TYPE 'END' AS LAST IN ANY STRING TO SET DURATION.
25700		IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
25800	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
25900	5155	P(L)=PAR
26000	21551	PL(L)=PM
26100		IF(ISUB)GO TO 601
26200		IF(L.EQ.2)GO TO 4203
26300	21552	IF(IDF.GE.0)GO TO 2155
26400		DF=PAR
26500		IDF=0
26600	2155	CONTINUE
26700	
26800	9203      IF(KB.EQ.0)GO TO 1170     
26900	       NL=KB
27000	      DO 2203 K=1,KB    
27100	      X=OTH(NL,1) 
27200	      IF(X.LT.100000.)GO TO 2203     
27300	      L=X/100000.
27400	      Y=(X-L*100000.)/100.    
27500	      IX=Y  
27600	      JC=NL 
27700	      IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203    
27800	2203  NL=NL-1     
27900	      GO TO 1170  
28000	4203      PR=P2 
28100	      IF(T5.EQ.0)GO TO 7203   
28200		IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
28300	3155	IT3=IT3+3
28400		TBG=TBG+TDUR
28500		TDUR=V(IT3)
28600		IF(BT.GE.TBG+TDUR)GO TO 3155
28700		T1=V(IT3+1)
28800		T2=V(IT3+2)
28900	CC	X=2.*TDUR/(T1+T2)
29000	CC	AC=2.*(TDUR-T1*X)/X**2
29050		CALL SQYY(AC,T1,T2,TDUR)
29100	6203	RA=PR 
29200		IF(BT.EQ.TBG)XT(J)=T1
29300		K=IT3
29400		RC=0  
29500		RD=1  
29600		KA=1  
29700		RB=0  
29800		Z=TDUR+TBG-BT	
29900		X=T1  
30000		Y=T2  
30100		YY=AC
30200		CHN=TBG	
30300		ZZ=TDUR	
30400		GO TO 4020  
30500	8203	P2=RA*RD    
30600	7203	P2=P2*T4
30700		X=P2*TF
30800	C  P2 IS KEPT WITHOUT TF*
30900		K=X+.5
31000		IF(X)K=X-.5
31100	72031	ROFF(J)=ROFF(J)+K-X
31200		IF(ABS(ROFF(J)).LT.1.)GO TO 7155
31300		Y=1.
31400		IF(ROFF(J))Y=-1.
31500		K=K-Y
31600		ROFF(J)=ROFF(J)-Y
31700	C  ROUND-OFF GAP WILL NOT EXCEED .001
31800	C*********** FEB 17,71
31900	7155	PP2=K/1000.
32000	C   AVOIDS ROUND-OFF PROBLEMS
32100		IF(IPT(J,31).EQ.0)GO TO 6155
32200		IF(ICT)GO TO 1170
32300		X=V(IPT(J,31)+2)/2.
32400		Y=RAND(-X,X)
32500		IF(PP2.GE.0)GO TO 615
32600		MK=-1
32700		PP2=-PP2
32800	615	PP2=PP2-RDEV(J)+Y
32900		RDEV(J)=Y
33000	C  TOTAL RAND DEV. WON'T EXCEED P31
33100	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
33200	
33300		K=PP2*1000.+.5
33400	C****** CHECK THIS OUT  1/10/72 :::::::
33500	61551	PP2=K/1000.
33600	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
33700	6155	IF(ICT)GO TO 9203
33800		GO TO 2155
33900	5203      JD=Y*100-IX*100+.5  
34000	      IF(JD.GT.0)GO TO 3203   
34100		M=0
34200		P1(J)=PP1+PP2
34300	      GO TO 7021  
34400	3203      P(JD)=OTH(JC,2)     
34500		X=OTH(JC,3)
34600		IF(X.NE.1.)X=3.
34700	C   'EDITS' PRINT,NUM. OR 5 CHARS.
34800	      PL(JD)=X
34900	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
35000		IF(JD.EQ.2)PP2=P2
35100	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
35200	1170      IF(MK.OR.PP2)GO TO 2022   
35300	
35400		ZPAR=PP1
35500		P1(J)=PP1+PP2
35600	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
35700		LK=INST(J)
35800	2021	IF(PP1.LT.OP1)GO TO 2612
35900		IF(INVIS(J).LT.0)GO TO 2170
36000	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
36100		IF(INONLY.GT.0)GO TO 1204
36200	C*********** MAY 16,71 ↑↑↑
36300	6021	IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
36400	C******* MAY 25,71
36500	C  'LIT' DATA WILL ALWAYS PRINT.
36600		NPA=NPA-1
36700		IF(NPA.GT.2)GO TO 6021
36800	5021	DO 1304 K=3,NPA
36900	1304	COPY(K)=P(K)
37000	1204	IF(PL4.NE.1.)GO TO 2170
37100		P4=P4*AMPFAC
37200		L=0
37300		INP(J)=P4
37400		DO 1021	K=1,NINS
37500	1021	IF(P1(K).GT.PP1)L=L+INP(K)
37600		IF(L-IAMP-1)GO TO 2170
37700		IAMP=L
37800		AMPTIM=PP1
37900	2170	IF(MX.EQ.3)GO TO 2612
38000	C ********* MAY 17,71
38100	      PP1=PP1-OP1     
38200	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
38300		IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
38400		IF(INONLY)WRITE(JOUT,902)
38500		A=PP1+.05
38600	5170	ML=10
38700		IF(NPA.LT.10)ML=NPA
38800		MLX=3
38900		NL=2
39000		IF(INVIS(J).EQ.0)GO TO 3170
39100	CC5170	IF(INVIS(J).EQ.0)GO TO 3170
39200	CC	MLX=3
39300		LK=0
39400	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
39500	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
39600	31701	KL=3
39700		GO TO 4170
39800	3170	IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
39900		VX(1)=PP1
40000		VX2=PP2*DF
40100		IFM3='F9.3,'
40200		IFM4=IFM3
40300		KL=5
40400	CC	ML=10
40500	CC	IF(NPA.LT.10)ML=NPA
40600	CC	MLX=3
40700	CC	NL=2
40800		IF(NPA.LT.3)GO TO 2121
40900	
41000	4170	NL=2
41100		DO 1121 K=MLX,ML
41200		X=P(K)
41300		L=PL(K)
41400		IF(L-2)321,521,621
41500	321	IF(X.GE.0)GO TO 4211
41600		IFM(KL)=IFCOM
41700		NL=NL+1
41800		KL=KL+1
41900	4211	IFM(KL)='F9.3,'
42000	C   CREATES 'F9.3'
42100	421	VX(KL-NL)=X
42200		GO TO 1121
42300	521	IFM(KL)=IFM2
42400	C   CREATES '1XA5'
42500		LN=X
42600		VX(KL-NL)=SCAL(LN)
42700		GO TO 42
42800	621	IF(L.GT.3)GO TO 721
42900		VX(KL-NL)=X
43000	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
43100	42	IFM(KL)=IFM2
43200		GO TO 1121
43300	721	LN=X
43400		IFM(KL)=I1X
43500		NL=NL+1
43600		DO 821 M=1,LN-L+1
43700		KL=KL+1
43800		IOUT(KL-NL)=IV(L-1+M)
43900	821	IFM(KL)=IA1
44000	1121	KL=KL+1
44100	
44200	C  NO MORE THAN 80 ITEMS IN FORMAT.
44300	2121	IF(KL.LE.80)GO TO 21211
44400	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
44500		TYPE 21212
44600	21211	DO 921 M=KL+1,80
44700	921 	IFM(M)=IBLA
44800		IFM(KL)=')'
44900		L=KL-NL-1
45000		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
45100		IF(.NOT.MZ)GO TO 30210
45200		IF(ML.GE.NPA)IFM(KL)='$)'
45300		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
45400	30210	IF(ML.GE.NPA)GO TO 3021
45500		MLX=ML+1
45600		ML=ML+10
45700		IF(ML.GT.NPA)ML=NPA
45800		LK=IBLA
45900		GO TO 31701
46000	3021	IF(MX)WRITE(1,3616)INST(J),ICT
46100	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
46200	2612      PP1=ZPAR     
46300	         GO TO 21 
46400	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
46500	3616	FORMAT(';PRINT(P1);< ',A5,I4)
46600	C   PRINTS RESTS  
46700	2022	PP2=ABS(PP2)
46800	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
46900	C   FOR RESTS IN SEQS. TYPE -DUR.   
47000	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
47100	C    RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
47200		INP(J)=0
47300		P1(J)=PP1+PP2
47400	C   STORES NEXT P1 TIME FOR THIS INST.
47500		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
47600	      X=PP1-OP1  
47700		IF(A.GE.X)GO TO 121
47800		WRITE(JOUT,902)
47900		A=X+.05
48000	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
48100		1 J,INST(J),ICT
48200	21	PR=ABS(PR)
48300	      BG(J)=BT+PR 
48400	      IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
48500	      IF(BG(J).LT.DUR(J))GO TO 500  
48600	5174      BG(J)=19999. 
48700	      DO 3174 K=1,NINS  
48800	C   INSERTS CANT FOLLOW LAST REGULAR NOTE.
48900	C   (ADD REST IF INSERT AT END IS NEEDED.)    
49000	3174      IF(BG(K).LT.19999.)GO TO 500     
49100	      GO TO 175   
49200	C   CHOOSES INST WITH NEXT BEGIN TIME.    
49300	500      J=1   
49400		BW=BT
49500	      NL=NINS+KB
49600	      DO 22 K=2,NL
49700	22      IF(BG(J).GT.BG(K))J=K 
49800		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
49900		J=1
50000		DO 5022 K=2,NINS
50100		X=P1(J)
50200		Y=P1(K)+.0001
50300	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
50400		IF(BG(J).EQ.19999.)X=19999.
50500		IF(BG(K).EQ.19999.)Y=19999.
50600	5022	IF(X.GT.Y)J=K
50700	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
50800	3022      BT=BG(J)    
50900	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
51000		IF(CNT(J).GT.0)GO TO 1022
51100	      IF(CNT(J).EQ.0)P1(J)=0  
51200	      IF(CNT(J).EQ.-1)CNT(J)=0
51300	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
51400	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
51500	      T4=T2 
51600	      T5=0  
51700	      T6=10000.   
51800	      GO TO 1108    
51900	1175	FORMAT('+',A5,'=',F7.3,2X,$)
52000	1109	FORMAT(' FINISH; < ',A5,'.DAT')
52100	1110	FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
52200	1603	FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
52300		1 F8.3)
52400	175	IF(MZ)WRITE(JOUT,1109),ISLAC
52500	CC	IF(MX.GE.0)GO TO 603
52600		IF(MX.GE.0)GO TO 4175
52700		WRITE(1,1109),ISLAC
52800		END FILE 1
52900	603	FORMAT(' TOTAL DURS:  ',$)
53000	CC	IF(MZ)GO TO 4175
53100	CC	TYPE 1603,AMPFAC,IAMP,AMPTIM
53200	CC	TYPE 603
53300	CC	GO TO 5175
53400	4175	WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
53500		WRITE(JOUT,603)
53600	5175	DO 2175 K=1,NINS
53700		X=P1(K)-OP1
53800		IF(MZ)GO TO 6175
53900		TYPE 1175,INST(K),X
54000		GO TO 2175
54100	6175	WRITE(JOUT,1175),INST(K),X
54200	2175	CONTINUE
54300		IF(JOUT.NE.22)GO TO 3175
54400		END FILE 22
54500		CALL PRINT
54600		REWIND 22
54700		K='FOR22'
54800		CALL OFILE(22,K)
54900	C   LEAVES FOR22.DAT WITH 0K
55000		END FILE 22
55100	3175	TYPE 1023,ISLAC
55200		END
55300	
55400		FUNCTION RMOVX(W,Y,Z)
55500		IF(W.EQ.0)W=.01
55600		IF(Y.EQ.0)Y=.01
55700		RMOVX=Y*((W/Y)**Z)
55900		END